BEGIN


% This program presents a set of functions which is equivalent to the
MLISP scanner.  It is for the reference of users wanting to implement
MLISP on a LISP system without Quam's READ-modifying  functions.   In
order  to  use  these  functions,  the  function  &SCAN  in the MLISP
translator should be replaced by the &SCAN function  below,  and  the
other  functions  added  where  convenient.   The functions below are
written in MLISP, so their LISP translations would actually be used.


The scanner below places only two restrictions on the LISP system:
(1) There  must  be a READCH function, which reads the next character
    in the input stream and returns that character as its value.

(2) There must be a READLIST function, which takes as its argument  a
    list of single characters and concatenates them to form an atom.


These two functions are taken to be primitives,  and  they  are  used
below  without  further explanation.  &SCAN sets the global variables
&SCANTYPE and &SCANVAL as follows:

Syntactic Type	      Value of &SCANTYPE	Value of &SCANVAL

<identifier>		      0			the identifier
<string>		      1			the string
<number>		      2			the number
<delimiter>		      3			the delimiter


!NEXT_CHAR  is  always  set to the next character in the input stream
after the current token has been obtained.

%
SPECIAL ?&SCANVAL, ?&SCANTYPE, ?&IDTYPE, ?&NUMTYPE, ?&STRTYPE, ?&DELIMTYPE;
SPECIAL LPAR, RPAR, PERIOD, BLANK, CR, LF, FF, VT, TAB, ALTMODE, DBQUOTE, PERCENT;
SPECIAL !NEXT_CHAR, !MLISP_LITERALLY_CHAR, !LITERALLY_CHARACTER, !IVALUE, !ILENGTH;
SPECIAL ?&X?&, ?&Y?&, IBASE;


EXPR ?&SCAN ();
	IF NUMBERP ?!NEXT_CHAR THEN SCAN_NUMBER()	% Number %
	ELSE IF LETTERP(?!NEXT_CHAR) THEN		% Identifier %
		SCAN_IDENTIFIER(NIL, ?!NEXT_CHAR)
	ELSE IF ?!NEXT_CHAR EQ DBQUOTE THEN		% String %
		SCAN_STRING(<DBQUOTE>, READCH())
	ELSE IF IGNOREP(?!NEXT_CHAR) THEN		% Ignorable char %
		DO NIL UNTIL NOT IGNOREP(?!NEXT_CHAR ← READCH())
			ALSO ?&SCAN()
	ELSE IF ?!NEXT_CHAR EQ PERCENT THEN		% Comment %
		BEGIN
		DO NIL UNTIL READCH() EQ PERCENT;
		?!NEXT_CHAR ← READCH();
		RETURN ?&SCAN();
		END
	ELSE SCAN_DELIMITER();				% Delimiter %


EXPR SCAN_IDENTIFIER (L, NXT);
	IF NUMBERP NXT OR GET(NXT, 'LETTER) THEN
		SCAN_IDENTIFIER(NXT CONS L, READCH())
	ELSE IF NXT EQ ?!MLISP_LITERALLY_CHAR THEN
		SCAN_IDENTIFIER(READCH() CONS ?!LITERALLY_CHARACTER CONS L,
			READCH())
	ELSE	BEGIN
		?&SCANTYPE ← ?&IDTYPE;
		?&SCANVAL  ← READLIST REVERSE L;
		IF ?&X?& AND GET(?&SCANVAL, '?&TRANS) THEN	% DEFINE'ed symbol %
			BEGIN
			?&SCANTYPE ← GET(?&SCANVAL, '?&TRANSTYPE);
			?&SCANVAL  ← GET(?&SCANVAL, '?&TRANS);
			END;
		?!NEXT_CHAR ← NXT;			% Set !NEXT_CHAR %
		END;


EXPR SCAN_STRING (L, NXT);
	IF NXT EQ DBQUOTE THEN
		BEGIN
		?&SCANTYPE ← ?&STRTYPE;
		?&SCANVAL  ← READLIST REVERSE(NXT CONS L);
		?!NEXT_CHAR ← READCH();			% Set !NEXT_CHAR %
		END
	ELSE SCAN_STRING(NXT CONS L, READCH());


EXPR SCAN_DELIMITER ();
	BEGIN
	?&SCANTYPE ← ?&DELIMTYPE;
	?&SCANVAL  ← ?!NEXT_CHAR;			% delim → &SCANVAL %
	IF ?&X?& AND GET(?&SCANVAL, '?&TRANS) THEN
		BEGIN					% DEFINE'ed symbol %
		?&SCANTYPE ← GET(?&SCANVAL, '?&TRANSTYPE);
		?&SCANVAL  ← GET(?&SCANVAL, '?&TRANS);
		END;
	?!NEXT_CHAR ← READCH();				% Set !NEXT_CHAR %
	END;


EXPR LETTERP (CHAR);
	GET(CHAR, 'LETTER) OR CHAR EQ ?!MLISP_LITERALLY_CHAR;


EXPR IGNOREP (CHAR);
	GET(CHAR, 'IGNORE);


EXPR SREAD ();						% Read sexpression %
	PROG2(?&SCAN(), SREAD1());


EXPR SREAD1 ();
	IF ?&SCANVAL EQ LPAR AND ?&SCANTYPE EQ 3 THEN	% ( %
		?&SCAN() ALSO SREAD2()
	ELSE ?&SCANVAL;


EXPR SREAD2 ();
	IF ?&SCANVAL EQ RPAR AND ?&SCANTYPE EQ 3 THEN	% ) %
		NIL
	ELSE	BEGIN  NEW X;
		X ← SREAD1();
		?&SCAN();
		RETURN X CONS SREAD3();
		END;


EXPR SREAD3 ();
	IF ?&SCANVAL EQ PERIOD AND ?&SCANTYPE EQ 3 THEN	% . %
		BEGIN  NEW X;				% Dotted pair (A.B) %
		X ← SREAD1();				% Get the "B" part %
		?&SCAN();				% Get rid of the ) %
		RETURN X;
		END
	ELSE SREAD2();


EXPR SCAN_NUMBER ();
	BEGIN  NEW ?!IVALUE, ?!ILENGTH, N, X;
	SCAN_INTEGER(?!NEXT_CHAR, 0, 0);		% Scan an integer %
	N ← ?!IVALUE;					% Save it %
	IF ?!NEXT_CHAR EQ '?. THEN			% Decimal number %
		BEGIN
		SCAN_INTEGER(READCH(), 0, 0);		% Scan decimal part %
		N ← N + ?!IVALUE / EXP(10.0, ?!ILENGTH);
		END;
	IF ?!NEXT_CHAR EQ 'E THEN			% Exponent %
		BEGIN
		?!NEXT_CHAR ← READCH();			% + or - ? %
		IF ?!NEXT_CHAR EQ '?+ THEN X ← 10.0	% + %
			ALSO ?!NEXT_CHAR ← READCH()
		ELSE IF ?!NEXT_CHAR EQ '?- THEN X ← 0.1	% - %
			ALSO ?!NEXT_CHAR ← READCH()
		ELSE X ← 10.0;
		SCAN_INTEGER(?!NEXT_CHAR, 0, 0);	% Get the exponent %
		N ← N * EXP(X, ?!IVALUE);
		END;
	% Now we've got the whole number %
	?&SCANTYPE ← ?&NUMTYPE;
	?&SCANVAL  ← N;					% Value %
	END;


EXPR SCAN_INTEGER (NXT, N, LEN);			% Scan an integer %
	IF NUMBERP NXT THEN
		SCAN_INTEGER(READCH(), N*IBASE + NXT, LEN+1)
	ELSE	BEGIN
		?!IVALUE    ← N;			% Value %
		?!ILENGTH   ← LEN;			% # digits %
		?!NEXT_CHAR ← NXT;			% Set !NEXT_CHAR %
		END;


EXPR EXP (N, E);					% Exponent function %
	IF E = 0 THEN 1.0				% Exponent is 0 %
	ELSE IF E = 2*(E/2) THEN EXP(N*N, E/2)		% Exponent is even %
	ELSE N * EXP(N*N, (E-1)/2);			% Exponent is odd %


% Calling the following function will initialize the  property  lists
needed by the functions above %


EXPR SCANINIT ();
	BEGIN
	FOR NEW CHAR IN
		'(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
		  a b c d e f g h i j k l m n o p q r s t u v w x y z
		  _ ?: ?!) DO
		PUTPROP(CHAR, T, 'LETTER);
	FOR NEW CHAR IN <BLANK,CR,LF,FF,VT,TAB,ALTMODE> DO
		PUTPROP(CHAR, T, 'IGNORE);
	?!LITERALLY_CHARACTER  ← '?/;		% LISP literally char (/) %
	?!MLISP_LITERALLY_CHAR ← '??;		% MLISP literally char (?) %
	?!NEXT_CHAR ← BLANK;			% Scanner starts blank %
	END;


EXPR SCANSET ();	NIL;			% Dummy definitions %

EXPR SCANRESET ();	NIL;


% The LISP translation of this program is  listed  in  the  following
section.   It  has  been  printed  using  a program called PPRINT, an
s-expression formatting (pretty-printing) program.  This  program  is
written in MLISP and is included  with the MLISP system.  (All of the
files in the MLISP system are listed  in  SECTION  4.3 .)  Note  that
FOR-loops,  WHILE-loops  and UNTIL-loops have been expanded by macros
into in-line code %


END.